home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / ERRBASE.I < prev    next >
Encoding:
Modula Implementation  |  1991-04-08  |  7.4 KB  |  254 lines
  1. IMPLEMENTATION MODULE ErrBase; (* V#119 *)
  2. (*$X+,Y+,S-,R-*)
  3. (* kein N+ einfügen! Runtime muß vor ErrBase importiert und init. werden,
  4.  * damit Runtime u.U. in MOSConfig "CaughtExceptions" f.die FPU-Exc
  5.  * erweitern kann! *)
  6.  
  7. (*
  8.   01.12.88 TT  SysInstalExc verw.
  9.   16.01.90 TT  CHK führt zu 'OutOfRange'
  10.   23.02.90 TT  Install/Remove exportiert, um Exc-Handler bei Accessories
  11.                von Außen zu installieren;
  12.                Wenn kein Handler installiert, wird SystemError bemüht
  13.   01.03.90 TT  Bei nicht installiertem Error-Handler wird kein normaler
  14.                Pterm sondern die entspr. Exception ausgelöst.
  15.   01.05.90 TT  'ExcInstalled' wird bei 'RemoveExc' wieder auf FALSE gesetzt
  16.   03.07.90 TT  'raising'-Abfrage entfernt: RaiseError sollte wieder gehen
  17.   29.07.90 TT  Korrektur in catchUser: RaiseError geht endlich wieder
  18.   25.11.90 TT  Wenn Handler nicht installiert, wird nur 'ExcInstalled' auf
  19.                FALSE gesetzt -> Aufrufer muß die Var prüfen;
  20.                Die FPU-Exceptions werden nun erkannt und die entspr. Laufzeit-
  21.                fehlernummern an den Err-Handler übergeben, zudem wird das
  22.                Bit 27 im BIU der FPU immer gesetzt, damit die FPU ggf. bei
  23.                "continue" weiterlaufen kann; $S-.
  24.   18.12.90 TT  FPU-Operand-Error führt zu 'OutOfRange'
  25.   08.04.91 TT  Alle CaughtExceptions werden nun in MOSConfig gesetzt.
  26. *)
  27.  
  28. FROM SYSTEM IMPORT ADR,ADDRESS,BYTE,LONGWORD,TSIZE, WORD, ASSEMBLER;
  29.  
  30. FROM Excepts IMPORT RaiseExc, SysInstallPreExc, DeInstallExc;
  31.  
  32. FROM SysTypes IMPORT ExcDesc, ZeroDivide, TRAP6, CHKExc, TRAPVExc, ExcSet,
  33.         BSUnExc, FPZeroDivide, OpError, FPOverflow, NANExc;
  34.  
  35. FROM MOSConfig IMPORT CaughtExceptions, IgnoreExceptions;
  36.  
  37. FROM ResCtrl IMPORT RemovalCarrier, CatchRemoval;
  38.  
  39. IMPORT MOSGlobals;
  40.  
  41.  
  42. VAR hdl2, hdl1:ADDRESS;
  43.     gl_no: INTEGER;
  44.     gl_cont: RtnCond;
  45.     gl_resp: ErrResp;
  46.     gl_msg: ARRAY [0..31] OF CHAR;
  47.  
  48. PROCEDURE catch (VAR info: ExcDesc): BOOLEAN;
  49.   VAR no:INTEGER;
  50.       zw: BOOLEAN;
  51.       msg:ARRAY [0..31] OF CHAR;
  52.       cont: RtnCond;
  53.       resp: ErrResp;
  54.   BEGIN
  55.     msg:='';
  56.     cont:= mayContinue;
  57.     resp:= selfCaused;
  58.     IF (LONGCARD(ErrHdl) = 0L) OR (info.excNo IN IgnoreExceptions) THEN
  59.       RETURN TRUE
  60.     ELSIF info.excNo=2 THEN
  61.       cont:= mustAbort;
  62.       no := MOSGlobals.BusFault
  63.     ELSIF info.excNo=3 THEN
  64.       cont:= mustAbort;
  65.       no := MOSGlobals.OddBusAddr
  66.     ELSIF info.excNo=4 THEN
  67.       IF info.regPC^ = WORD ($4AFC) THEN
  68.         RETURN TRUE (* Break zum Monitor immer durchlassen *)
  69.       END;
  70.       cont:= mustAbort;
  71.       no := MOSGlobals.IllegalInstr
  72.     ELSIF (info.excNo=NANExc) OR (info.excNo=BSUnExc) THEN
  73.       no := MOSGlobals.GenFPErr
  74.     ELSIF (info.excNo=ZeroDivide) OR (info.excNo=FPZeroDivide) THEN
  75.       no := MOSGlobals.DivByZero
  76.     ELSIF (info.excNo=FPOverflow) OR (info.excNo=TRAPVExc) THEN
  77.       no := MOSGlobals.Overflow
  78.     ELSIF (info.excNo=OpError) OR (info.excNo=CHKExc) THEN
  79.       no := MOSGlobals.OutOfRange
  80.     ELSIF info.excNo=TRAP6 THEN
  81.       ASSEMBLER
  82.         MOVE.L  info(A6),A0
  83.         MOVE.L  ExcDesc.regPC(A0),A1
  84.         MOVE.W  (A1)+,D0
  85.         BMI     notxt
  86.         
  87.         LEA     msg(A6),A2
  88.         MOVEQ   #31,D2
  89.        loo:
  90.         MOVE.B  (A1)+,(A2)+
  91.         DBEQ    D2,loo
  92.         BEQ     c2
  93.        l2:
  94.         TST.B   (A1)+
  95.         BNE     l2
  96.        c2:
  97.         MOVE    A1,D1
  98.         LSR     #1,D1
  99.         BCC     c3
  100.         ADDQ.L  #1,A1
  101.        c3:
  102.         
  103.        notxt:
  104.         MOVE.L  A1,ExcDesc.regPC(A0)
  105.         MOVE    D0,D1
  106.         LSL     #4,D1
  107.         ASR     #4,D1
  108.         MOVE    D1,no(A6)
  109.         
  110.         BTST    #14,D0
  111.         SEQ     D1
  112.         ANDI    #1,D1
  113.         MOVE    D1,resp(A6)
  114.         
  115.         BTST    #13,D0
  116.         SEQ     D1
  117.         ANDI    #1,D1
  118.         MOVE    D1,cont(A6)
  119.       END
  120.     ELSE
  121.       no:= MOSGlobals.Exception
  122.     END;
  123.     ASSEMBLER
  124.         ; bei FPU-Exceptions (48-54) diese bei der FPU bestätigen
  125.         MOVE.L  info(A6),A0
  126.         MOVE.W  ExcDesc.excNo(A0),D0
  127.         CMPI    #48,D0
  128.         BCS     noFPU
  129.         CMPI    #54,D0
  130.         BHI     noFPU
  131.         
  132.         ; Set Bit 27 in BIU
  133.         CLR.L   -(A7)
  134.         MOVE    #$20,-(A7)      ; Super (0)
  135.         TRAP    #1
  136.         MOVE.L  D0,2(A7)
  137.         FSAVE   -(SP)
  138.         TST.B   (SP)
  139.         BEQ     nullFrame
  140.         CLR     D0
  141.         MOVE.B  1(SP),D0
  142.         BSET    #3,(SP,D0.W)
  143.       nullFrame
  144.         FRESTORE (SP)+
  145.         TRAP    #1
  146.         ADDQ.L  #6,A7
  147.         
  148.       noFPU
  149.         MOVE    no(A6),(A3)+
  150.         LEA     msg(A6),A0
  151.         MOVE.L  A0,(A3)+
  152.         MOVE    #31,(A3)+
  153.         MOVE    resp(A6),(A3)+
  154.         MOVE    cont(A6),(A3)+
  155.         MOVE.L  info(A6),(A3)+
  156.         MOVE.L  ErrHdl,A0
  157.         JSR     (A0)
  158.     END;
  159.     RETURN FALSE
  160.   END catch;
  161.  
  162.  
  163. PROCEDURE catchUser (VAR info:ExcDesc): BOOLEAN;
  164.   (*$L-*)
  165.   BEGIN
  166.     ASSEMBLER
  167.         MOVE.L  -(A3),D1
  168.         MOVE.L  ErrHdl,D0
  169.         BEQ     retT
  170.         MOVE.L  D0,A0
  171.         MOVE    gl_no,(A3)+
  172.         MOVE.L  #gl_msg,(A3)+
  173.         MOVE    #31,(A3)+
  174.         MOVE    gl_resp,(A3)+
  175.         MOVE    gl_cont,(A3)+
  176.         MOVE.L  D1,(A3)+
  177.         JSR     (A0)
  178.         CLR     (A3)+
  179.         RTS
  180.       retT:
  181.         MOVE    #1,(A3)+
  182.     END
  183.   END catchUser;
  184.   (*$L+*)
  185.  
  186. PROCEDURE RaiseError ( no    : INTEGER;
  187.                        REF msg   : ARRAY OF CHAR;
  188.                        causer: ErrResp;
  189.                        cont  : RtnCond );
  190.   (*$L-*)
  191.   BEGIN
  192.     ASSEMBLER
  193.         MOVE    -(A3),gl_cont
  194.         MOVE    -(A3),gl_resp
  195.         
  196.         MOVE    -(A3),D0
  197.         MOVE.L  -(A3),A0
  198.         LEA     gl_msg,A1
  199.         MOVEQ   #31,D1
  200.         BRA     y
  201.      x: SUBQ    #1,D0
  202.         BCS     o         ; Source-Ende, Dest. muss Endmarke bekommen
  203.      y: MOVE.B  (A0)+,(A1)+
  204.         DBEQ    D1,x
  205.         BRA     e
  206.      o: CLR.B   (A1)+
  207.      
  208.      e: MOVE    -(A3),gl_no
  209.         
  210.         MOVE    #$E0,(A3)+
  211.         JMP     RaiseExc
  212.     END
  213.   END RaiseError;
  214.   (*$L+*)
  215.  
  216.  
  217. PROCEDURE RemoveExc;
  218.   BEGIN
  219.     IF ExcInstalled THEN
  220.       DeInstallExc (hdl1);
  221.       DeInstallExc (hdl2);
  222.       ExcInstalled:= FALSE;
  223.     END
  224.   END RemoveExc;
  225.  
  226. VAR stk: ARRAY [1..500] OF WORD;
  227.     wsp: MOSGlobals.MemArea;
  228.     rHdl: RemovalCarrier;
  229.  
  230. PROCEDURE InstallExc;
  231.   BEGIN
  232.     IF NOT ExcInstalled THEN
  233.       SysInstallPreExc (CaughtExceptions, catch, TRUE, wsp, hdl2 );
  234.       IF hdl2 # NIL THEN
  235.         SysInstallPreExc (ExcSet{$E0}, catchUser, TRUE, wsp, hdl1); (* reservierte Exc-Nr.*)
  236.         IF hdl1 # NIL THEN
  237.           ExcInstalled:= TRUE
  238.         ELSE
  239.           DeInstallExc (hdl2)
  240.         END
  241.       END
  242.     END;
  243.   END InstallExc;
  244.  
  245. BEGIN
  246.   ExcInstalled:= FALSE;
  247.   ErrHdl:= ErrHdlProc (0L);
  248.   CatchRemoval (rHdl, RemoveExc, wsp);
  249.   wsp.bottom:= ADR (stk);
  250.   wsp.length:= SIZE (stk);
  251. END ErrBase.
  252. ə
  253. (* $00001455$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$00001122$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$FFFA73DA$000018B6Ç$0000057CT.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00000110$0000057E$0000053B$FFE489D2$00000AE4$FFE489D2$0000196B$0000197A$00000539$00000541$0000057C$0000054B$0000057C$0000006F$00000BC7$00000BEFÕÇü*)
  254.